home *** CD-ROM | disk | FTP | other *** search
/ AMIGA-CD 2 / Amiga-CD - Volume 2.iso / ungepackte_daten / 1994 / 6 / 02 / einstein / einstein.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-06-01  |  7.4 KB  |  256 lines
  1. program einstein;
  2. (****03.02.94*******************************************
  3. *                                                      *
  4. *                     DeepSpace9                       *
  5. *                                                      *
  6. *          (c) 1994 by Daniel Gembris                  *
  7. *                                                      *
  8. *    Dieses Programm berechnet die Ansicht eines fast  *
  9. *    mit Lichtgeschwindigkeit fliegenden Würfels für   *
  10. *    einen ruhenden Beobachter.                        * 
  11. *                                                      *
  12. *    Das Programm basiert auf folgendem Artikel, der   *
  13. *    in den "Proceedings auf the SIGGRAPH convention"  *
  14. *    (1990) erschienen ist:                            *
  15. *    " T-Buffer: Fast Visualization of Relativistic    *
  16. *    Effects in Spacetime", Pink-Kang Hsiung,          *
  17. *    Robert H. Thibadeau, Michael Wu (Carnegie Mellon  *
  18. *    University; Pittsburgh, Pennsylvania 15213)       *
  19. *                                                      *
  20. ********************************************************)
  21.  
  22. uses graphics,intuition;
  23.  
  24. const YRES = 512;
  25.       XRES = 640;
  26.       c = 299792.5;       (* Lichtgeschwindigkeit in km/s *)
  27.       pi=3.14159;
  28.       anzpunkte=8;
  29.  
  30.       anzkanten=12;
  31.       schrittweite=10;    (* alle <schrittweite> km ein Foto *)
  32.  
  33. type tpunkt = record
  34.          x,y,z:longint;
  35.      end;
  36.      tpunkte=array[0..anzpunkte-1,0..2] of longint;
  37.      tkanten=array[0..anzkanten-1,0..1] of longint;
  38.  
  39. var vx,vy,vz: real;  (* Objekt-Geschwindigkeitsvektor *)
  40.     r,r1:real;
  41.     punkte:tpunkte;
  42.     kanten:tkanten;
  43.     viewx,viewy,viewz,viewt:real;
  44.     (* xz-Ebene ist Projektionsebene *)
  45.     i,steps:integer;  (* in soviele Stücke wird eine Kante zerlegt *)
  46.     frames:integer;   (* Anzahl der Animations-Frames *)
  47.     shandle,shandle2:^screen;
  48.     whandle,whandle2:^Window;
  49.     rhandle,rhandle2,msg:ptr;
  50.     dummy:LONG;
  51.     stri:string;
  52.     erg:boolean;
  53.     a,b:real;          (* Winkel der Flugbahn *)
  54.  
  55. PROCEDURE Graphik_einschalten;
  56. BEGIN
  57.     (* OpenLib(gfxbase,"graphics.library",0);
  58.     OpenLib(_intuitionbase,"intuition.library",0); *)
  59.     shandle:=Open_Screen(0,0,XRES+1,YRES+1,1,0,1,LACE+HIRES,"STARTREK");
  60.     SetRGB4(^Shandle^.ViewPort,0,0,0,0);
  61.     SetRGB4(^Shandle^.ViewPort,1,15,15,15);
  62.     whandle:=Open_Window(0,0,XRES+1,YRES+1,1,ACTIVEWINDOW,BACKDROP+BORDERLESS,"DeepSpace9",shandle,0,0,xres+1,yres+1);
  63.     rhandle:=^shandle^.rastport;
  64.     shandle2:=Open_Screen(0,0,XRES+1,YRES+1,1,0,1,LACE+HIRES,"STARTREK");
  65.     SetRGB4(^Shandle2^.ViewPort,0,0,0,0);
  66.     SetRGB4(^Shandle2^.ViewPort,1,15,15,15);
  67.     whandle2:=Open_Window(0,0,XRES+1,YRES+1,1,ACTIVEWINDOW,BACKDROP+BORDERLESS,"DeepSpace9",shandle2,0,0,xres+1,yres+1);
  68.     rhandle2:=^shandle2^.rastport;
  69.  
  70. END;  {Ende von PROCEDURE Graphik_einschalten}
  71.  
  72. procedure eingabe;
  73. begin
  74.    viewx:=XRES/2.0;  (* Beobachtungsereignis *)
  75.    viewy:=-450.0;
  76.    viewz:=YRES/2.0;
  77.    viewt:=0.0;
  78.    (* xz-Ebene ist Projektionsebene *)
  79.    steps:=5;  (* in soviele Stücke wird eine Kante zerlegt *)
  80.    punkte:= tpunkte(
  81.       (100,0,0),
  82.       (300,0,0),
  83.       (300,200,0),
  84.       (100,200,0),
  85.       (100,0,200),
  86.       (300,0,200),
  87.       (300,200,200),
  88.       (100,200,200));  (* Die Koordinaten beziehen sich auf das Objekt-Inertialsystem *)
  89.    kanten:=tkanten(
  90.       (0,1),(1,2),(2,3),(3,0),(4,5),(5,6),(6,7),(7,4),(0,4),(1,5),(2,6),(3,7)
  91.       );
  92.    clrscr;
  93.    writeln('              DeepSpace9');
  94.    writeln('              ==========');
  95.    writeln;
  96.    writeln('Dieses Programm berechnet die Ansicht eines fast mit ');
  97.    writeln('Lichtgeschwindigkeit fliegenden Würfels für einen ruhenden');
  98.    writeln('Beobachter.');
  99.    writeln;
  100.    writeln('(c) 1994 by Daniel Gembris');
  101.    writeln;
  102.    write('Wieviele Animationsframes sollen erzeugt werden ? ');
  103.    readln(frames);
  104.    writeln('Bitte geben Sie die Geschwindigkeit des Quaders in x% der Licht-');
  105.    write('geschwindigkeit ein:');
  106.    readln(r1);
  107.    writeln;
  108.    writeln('  z ^  y  ');
  109.    writeln('    |/    ');
  110.    writeln('    --> x ');
  111.    writeln;
  112.    write('xz-Winkel (in Grad, z.B.:   0) : ');
  113.    readln(a);
  114.    write('xy-Winkel (in Grad, z.B.:-180) : ');
  115.    readln(b);
  116.    r:=r1*c/100.0;
  117.    a:=a*2.0*pi/360.0;
  118.    b:=b*2.0*pi/360.0;
  119.    vx:=cos(b)*cos(a)*r;
  120.    vy:=sin(b)*cos(a)*r;
  121.    vz:=sin(a)*r;
  122. end;
  123. (* forward Lorentz transformation -
  124.    Umwandlung von Kamera- in Objekt-Ereignisse *)
  125. procedure fLorenz(var x,y,z,t:real);
  126. var gamma,coef,vsqr,xv:real;
  127. begin
  128.    vsqr:=vx*vx+vy*vy+vz*vz;
  129.    xv:=x*vx+y*vy+z*vz;
  130.    gamma:=1.0/sqrt(1.0-vsqr/(c*c));
  131.    coef:=(gamma-1)/vsqr*xv-gamma*t;
  132.    x:=x+coef*vx;
  133.    y:=y+coef*vy;
  134.    z:=z+coef*vz;
  135.    t:=gamma*(t-xv/(c*c));
  136. end;
  137. (* inverse Lorentz-Transformation -
  138.    Umwandlung von Objekt- in Kamera-Ereignisse *)
  139. procedure iLorenz(var x,y,z,t:real);
  140. var gamma,coef,vsqr,xv:real;
  141. begin
  142.    vsqr:=vx*vx+vy*vy+vz*vz;
  143.    xv:=-x*vx-y*vy-z*vz;
  144.    gamma:=1.0/sqrt(1.0-vsqr/(c*c));
  145.    coef:=(gamma-1)/vsqr*xv-gamma*t;
  146.    x:=x-coef*vx;
  147.    y:=y-coef*vy;
  148.    z:=z-coef*vz;
  149.    t:=gamma*(t-xv/(c*c));
  150. end;
  151. procedure projektion(x,y,z:real;var xscreen,yscreen:integer);
  152. var alpha:real;
  153. begin
  154.    alpha:=viewy/(y-viewy);
  155.    x:=viewx+alpha*(viewx-x);
  156.    z:=viewz+alpha*(viewz-z);
  157.    y:=YRES-z;
  158.    if((y<YRES)and(y>=0)and(x>=0)and(x<XRES)) then begin
  159.         xscreen:=trunc(x);
  160.         yscreen:=trunc(y);
  161.    end
  162.    else  xscreen:=-1;
  163.  
  164. end;
  165. procedure deepspace9(nr:integer);
  166. var viewx2,viewy2,viewz2,viewt2,x,y,z,x2,y2,z2,t,dx,dy,dz:real;
  167.     ddx,ddy,ddz:real;
  168.     punktnr:longint;
  169.     xscreen,yscreen,i,j:integer;
  170.     startok:boolean;
  171.     rh:ptr;
  172. begin
  173.    if(odd(nr)) then begin
  174.                   rh:=rhandle;
  175.                   ScreenToFront(shandle2);
  176.    end
  177.    else begin
  178.                   rh:=rhandle2;
  179.                   ScreenToFront(shandle);
  180.    end;
  181.  
  182.    Move(rh,0,0);
  183.    SetAPen(rh,0);
  184.    RectFill(rh,0,0,XRES,YRES);
  185.    SetAPen(rh,1);
  186.    Move(rh,200,20);
  187.    stri:=intstr(trunc(r1))+'% der Lichtgeschwindigkeit';
  188.    erg:=_text(rh,stri,length(stri));
  189.  
  190.    ddx:=nr*schrittweite*cos(a)*cos(b);
  191.    ddy:=nr*schrittweite*sin(b)*cos(a);
  192.    ddz:=nr*schrittweite*sin(a);
  193.  
  194.    viewx2:=viewx;
  195.    viewy2:=viewy;
  196.    viewz2:=viewz;
  197.    viewt2:=viewt;
  198.    fLorenz(viewx2,viewy2,viewz2,viewt2);
  199.    for i:=0 to (anzkanten-1) do begin
  200.       punktnr:=kanten[i][0];
  201.       x:=punkte[punktnr][0];
  202.       y:=punkte[punktnr][1];
  203.       z:=punkte[punktnr][2];
  204.       punktnr:=kanten[i][1];
  205.       dx:=(punkte[punktnr][0]-x)/steps;
  206.       dy:=(punkte[punktnr][1]-y)/steps;
  207.       dz:=(punkte[punktnr][2]-z)/steps;
  208.       x:=x+ddx;
  209.       y:=y+ddy;
  210.       z:=z+ddz;
  211.       startok:=FALSE;
  212.       for j:=0 to steps do begin
  213.          t:=viewt2-sqrt((x-viewx2)*(x-viewx2)+(y-viewy2)*(y-viewy2)+(z-viewz2)*(z-viewz2))/c;
  214.          x2:=x; y2:=y; z2:=z;
  215.          iLorenz(x2,y2,z2,t);
  216.          projektion(x2,y2,z2,xscreen,yscreen);
  217.          if(xscreen<>-1) then begin
  218.              if(startok) then Draw(rh,xscreen,yscreen)
  219.              else Move(rh,xscreen,yscreen);
  220.              startok:=TRUE;
  221.          end
  222.          else startok:=FALSE;
  223.          x:=x+dx;
  224.          y:=y+dy;
  225.          z:=z+dz;
  226.       end;
  227.    end;
  228. end;
  229. begin  (* Hauptprogramm *)
  230.   eingabe;
  231.   Graphik_einschalten;
  232.   SetAPen(rhandle,1);
  233.   for i:=1 to frames do deepspace9(i);
  234.   if(odd(frames)) then begin
  235.        ScreenToFront(shandle);
  236.        msg:=waitport(whandle^.userport);
  237.        msg:=getmsg(whandle^.userport);
  238.        replymsg(msg);
  239.   end
  240.   else begin
  241.        ScreenToFront(shandle2);
  242.        msg:=waitport(whandle2^.userport);
  243.        msg:=getmsg(whandle2^.userport);
  244.        replymsg(msg);
  245.   end;
  246. end.
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.